home *** CD-ROM | disk | FTP | other *** search
/ POINT Software Programming / PPROG1.ISO / pascal / swag / interrup.swg / 0006_Critical Error Trap.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-05-31  |  6.2 KB  |  109 lines
  1. ==============================================================================
  2.  BBS: -=- Edge of the Century -=-
  3.   To: DANIEL KEMPTON               Date: 01-20-93 (05:13)
  4. From: GREG VIGNEAULT             Number: 3196   [140] Pascal
  5. Subj: CRITICAL ERROR HANDLER     Status: Public
  6. ------------------------------------------------------------------------------
  7. DK> Can anyone PLEASE give me information on how to write a critical
  8.   > error handler.
  9.  
  10.  Below is a quick'n-dirty critical error handler, written without
  11.  any Asm (so is usable from TP v4.0+).  To test it, put a write-
  12.  protected diskette in drive A:, then run the program.  It should
  13.  report error #19 (13 hex, disk write-protected).
  14.  
  15.  It'll need to be modified & trimmed to your purpose.  You might
  16.  code your handler to simply ignore errors, then let your main
  17.  program take appropriate action, depending on the error, etc.
  18.  
  19.  DOS functions $00..$0C, $30, and $59 should be safe calls from the
  20.  handler.  Function $59 will return the extended error information
  21.  code that you'll need to check (eg. #32 = share violation), as well
  22.  as other data - which you can read up on, in a Dos reference text.
  23.  
  24.  I've used one byte of the DOS intra-process communication area (at
  25.  $40:$F0) to return the value needed to tell Dos what to do about
  26.  the error, rather than juggle registers.  This should be okay.
  27.  
  28.  This code is cramped, to fit into a single message ...
  29.  
  30. {*******************************************************************}
  31.  PROGRAM Example;                       { Critical Error Handler    }
  32.  USES Dos,      { import MsDos, GetIntVec, SetIntVec, Registers     }
  33.       Crt;      { import CheckBreak                                 }
  34.  VAR OldISR     : POINTER;              { to save original ISR ptr  }
  35.      Reg        : Registers;            { to access CPU registers   }
  36.      errNumber  : WORD;                 { extended error code       }
  37.      errClass,                          { error class               }
  38.      errAction,                         { recommended action        }
  39.      errLocus   : BYTE;                 { error locus               }
  40.      FileName   : String[13];           { for ASCIIZ file name      }
  41. {-------------------------------------------------------------------}
  42.  PROCEDURE cErrorISR( AX,BX,CX,DX,SI,DI,DS,ES,BP : WORD); Interrupt;
  43.     BEGIN  { This is it! ...                                        }
  44.     InLine($FB);                        { STI (allow interrupts)    }
  45.     Reg.AX := $3000;  MsDos(Reg);       { fn: get Dos version       }
  46.     IF (Reg.AH < 3) THEN Reg.AL := 3    { if less than Dos 3+ :FAIL }
  47.         ELSE BEGIN                      { else take a closer look.. }
  48.         Reg.AH := $59;  Reg.BX := 0;    { fn: get extended info     }
  49.         MsDos( Reg );                   { call Dos                  }
  50.         errNumber := Reg.AX;            { set|clear error number    }
  51.         errClass := Reg.BH; errAction := Reg.BL; errLocus := Reg.CH;
  52.         WriteLn;  Write( 'Critical error (#', errNumber, ') ' );
  53.         REPEAT WriteLn;                 { loop for user response    }
  54.           Write( 'Abort, Retry, Ignore, Fail (A|R|I|F) ? ',#7);
  55.           Reg.AH := 1;  MsDos(Reg);     { get user input, via Dos   }
  56.         UNTIL UpCase(CHR(Reg.AL)) IN ['A','R','I','F'];
  57.         CASE CHR(Reg.AL) OF             { ... depending on input    }
  58.             'i','I' : Reg.AL := 0;      { = ignore error            }
  59.             'r','R' : Reg.AL := 1;      { = retry the action        }
  60.             'a','A' : Reg.AL := 2;      { = abort                   }
  61.             'f','F' : Reg.AL := 3;      { = fail                    }
  62.             END; {case}
  63.         END; {if Reg.AH}
  64.     Mem[$40:$F0] := Reg.AL;             { to tell Dos what to think }
  65.     InLine( $8B/$E5/                    { mov   sp,bp               }
  66.             $5D/$07/$1F/$5F/$5E/        { pop   bp,es,ds,di,si      }
  67.             $5A/$59/$5B/$58/            { pop   dx,cx,bx,ax         }
  68.             $06/                        { push  es                  }
  69.             $2B/$C0/                    { sub   ax,ax               }
  70.             $8E/$C0/                    { mov   es,ax               }
  71.             $26/$A0/$F0/$04/            { mov   al,es:[4F0h]        }
  72.             $07/                        { pop   es                  }
  73.             $CF);                       { iret                      }
  74.     END {cErrorISR};
  75. {-------------------------------------------------------------------}
  76.  BEGIN  { the main program...                                       }
  77.     CheckBreak := FALSE;                { don't allow Ctrl-Break!   }
  78.     errNumber := 0;                     { clear the error code      }
  79.     GetIntVec( $24, OldISR );           { save current ISR vector   }
  80.     SetIntVec( $24, @cErrorISR );       { set our ISR               }
  81.         {===========================================================}
  82.         { insert your test code here ...                            }
  83.         FileName := 'A:TEST.TXT' + CHR(0);  { ASCIIZ file name      }
  84.         Reg.DS := SEG( FileName );          { file name segment     }
  85.         Reg.DX := OFS( FileName[1] );       { file name offset      }
  86.         Reg.CX := 0;                        { normal attribute      }
  87.         Reg.AH := $3C;                      { fn: create file       }
  88.         MsDos( Reg );                       { via Dos               }
  89.         {===========================================================}
  90.     IF (errNumber <> 0) THEN BEGIN
  91.         Write(#13#10#10,'For error #',errNumber,', user requested ');
  92.         CASE Mem[$40:$F0] OF
  93.             0   : WriteLn('IGNORE');    { just your imagination     }
  94.             1   : WriteLn('RETRY');     { ... endless futility ?    }
  95.             2   : WriteLn('ABORT');     { DOS won't come back here! }
  96.             3   : WriteLn('FAIL');      { call technical support    }
  97.             END; {case}
  98.         END; {if errNumber<>0}
  99.     SetIntVec( $24, OldISR );           { must restore original ISR }
  100.  END.
  101. {*******************************************************************}
  102.  
  103.  Greg_
  104.  
  105.  Jan.20.1993.Toronto.Canada.        greg.vigneault@bville.gts.org
  106. ---
  107.  * Baudeville BBS Toronto CANADA 416-283-0114 2200+ confs
  108.  * PostLink(tm) v1.04  BAUDEVILLE (#1412) : RelayNet(tm)
  109.